Intentos de suicidio en colombia desde 2016 hasta 2023
Cada fila corresponde a una persona que intentó suicidarse e incluye información como el municipio y departamento de ocurrencia.
✨ Clase con el experto David Santis ✨
Departamento_ocurrencia = c(
"ANTIOQUIA", "ATLANTICO", "BOGOTA", "BOLIVAR", "BOYACA", "CALDAS", "CAQUETA", "CAUCA", "CESAR", "CORDOBA", "CUNDINAMARCA","CHOCO", "HUILA", "GUAJIRA",
"MAGDALENA", "META", "NARIÑO","NORTE DE SANTANDER","QUINDIO", "RISARALDA","SANTANDER" , "SUCRE","TOLIMA", "VALLE", "ARAUCA ", "CASANARE", "PUTUMAYO", "AMAZONAS", "GUAINIA", "GUAVIARE", "VAUPES",
"VICHADA", "SAN ANDRÉS")
colombia$NOMBRE_DPT <- Departamento_ocurrenciaEntre 2016 y 2023, Colombia registró un aumento sostenido en los intentos de suicidio, con cifras alarmantes en municipios de departamentos como Vaupés, Risaralda, Caldas, Santander, Putumayo y Amazonas. Solo entre enero y mayo de 2023 se notificaron 40.850 intentos y 3.241 suicidios consumados, siendo Bucaramanga, Floridablanca, Mitú y Taraira algunos de los municipios más afectados. La mayor incidencia se presentó en jóvenes y adolescentes, especialmente en regiones rurales e indígenas, evidenciando la necesidad de intervenciones focalizadas.
# Bases de datos
suicidio_data2016 <- read_csv("suicidio_data2016.csv")
suicidio_data2017 <- read_csv("suicidio_data2017.csv")
suicidio_data2018 <- read_csv("suicidio_data2018.csv")
suicidio_data2019 <- read_csv("suicidio_data2019.csv")
suicidio_data2020 <- read_csv("suicidio_data2020.csv")
suicidio_data2021 <- read_csv("suicidio_data2021.csv")
suicidio_data2022 <- read_csv("suicidio_data2022.csv")
suicidio_data2023 <- read_csv("suicidio_data2023.csv")
Datos_completos <- bind_rows(suicidio_data2016, suicidio_data2017, suicidio_data2018,suicidio_data2019,suicidio_data2020,suicidio_data2021,suicidio_data2022, suicidio_data2023)
Datos_completos <- Datos_completos |>
filter(Departamento_ocurrencia != "PROCEDENCIA DESCONOCIDA", Municipio_ocurrencia != "* ANTIOQUIA. MUNICIPIO DESCONOCIDO")
Datos_completos <- Datos_completos |> group_by(ANO, COD_DPTO_O, Departamento_ocurrencia, COD_MUN_O, Municipio_ocurrencia ) |> summarise(Total_casos = n(), .groups = "drop") |> filter(Total_casos > 0)
datos_departamentos <- Datos_completos %>%
group_by(ANO, COD_DPTO_O, Departamento_ocurrencia) %>%
summarise(Total_casos_dep = sum(Total_casos, na.rm = TRUE), .groups = "drop")
datos_dpto_resumidos <- datos_departamentos %>%
group_by(ANO,COD_DPTO_O,Departamento_ocurrencia) %>%
summarise(Total_casos_dep_año = sum(Total_casos_dep, na.rm = TRUE), .groups = "drop")
Departamento_ocurrencia <- c(
"ANTIOQUIA", "ATLANTICO", "BOGOTA", "BOLIVAR", "BOYACA", "CALDAS", "CAQUETA",
"CAUCA", "CESAR", "CORDOBA", "CUNDINAMARCA", "CHOCO", "HUILA", "GUAJIRA",
"MAGDALENA", "META", "NARIÑO", "NORTE SANTANDER", "QUINDIO", "RISARALDA",
"SANTANDER", "SUCRE", "TOLIMA", "VALLE", "ARAUCA", "CASANARE", "PUTUMAYO",
"AMAZONAS", "GUAINIA", "GUAVIARE", "VAUPES", "VICHADA", "SAN ANDRES"
)
Poblacion_2023 <- c(
6848360, 2803565, 7907281, 2247283, 1298800, 1040284, 425053,
1558045, 1373581, 1898911, 3445327, 595138, 1178453, 1038397,
1496163, 1130085, 1699570, 1696740, 563076, 972304,
2357127, 994060, 1374384, 4638029, 313097, 467775, 383042,
85056, 56551, 97616, 46777, 123304, 62269
)
df_poblacion <- tibble(
Departamento_ocurrencia,
Poblacion_2023
)
Datos_Dpto_completos <- datos_dpto_resumidos |>
left_join(df_poblacion, by = "Departamento_ocurrencia")
top_15_departamentos <- Datos_Dpto_completos %>%
arrange(desc(Total_casos_dep_año)) %>%
slice_head(n = 15)
top_15_departamentos# A tibble: 15 × 5
ANO COD_DPTO_O Departamento_ocurrencia Total_casos_dep_año Poblacion_2023
<dbl> <dbl> <chr> <int> <dbl>
1 2023 5 ANTIOQUIA 6286 6848360
2 2023 11 BOGOTA 6046 7907281
3 2022 11 BOGOTA 5737 7907281
4 2022 5 ANTIOQUIA 5615 6848360
5 2019 5 ANTIOQUIA 5156 6848360
6 2018 5 ANTIOQUIA 4982 6848360
7 2017 5 ANTIOQUIA 4735 6848360
8 2021 11 BOGOTA 4565 7907281
9 2021 5 ANTIOQUIA 4482 6848360
10 2020 5 ANTIOQUIA 4283 6848360
11 2023 76 VALLE 3749 4638029
12 2022 76 VALLE 3442 4638029
13 2019 76 VALLE 3099 4638029
14 2016 5 ANTIOQUIA 3033 6848360
15 2020 11 BOGOTA 3019 7907281
Entre 2017 y 2023, los intentos de suicidio en Colombia muestran una tendencia creciente, especialmente en los departamentos de Antioquia y Bogotá, que concentran las cifras más altas del país. En 2023, Antioquia reportó 6.286 casos y Bogotá 6.046, reflejando un aumento sostenido en comparación con años anteriores. Esta evolución sugiere un agravamiento de los problemas de salud mental o una mejora en los sistemas de registro y notificación.
La concentración de casos en estos territorios podría estar relacionada con factores como la alta densidad poblacional, el estrés urbano, la desigualdad social o el acceso limitado a servicios de salud mental.
departamentos <- unique(Datos_Dpto_completos$Departamento_ocurrencia)
n <- length(departamentos)
pal <- colorRampPalette(brewer.pal(8, "Set2"))(n)
fig <- Datos_Dpto_completos %>%
plot_ly(
x = ~ANO,
y = ~Total_casos_dep_año,
color = ~Departamento_ocurrencia,
colors = pal,
type = 'scatter',
mode = 'lines+markers',
hoverinfo = 'text',
text = ~paste("Departamento:", Departamento_ocurrencia,
"<br>Año:", ANO,
"<br>Casos:", Total_casos_dep_año)
) %>%
layout(
title = "Evolución anual de casos por departamento",
xaxis = list(title = "Año"),
yaxis = list(title = "Total casos"),
legend = list(title = list(text = "<b>Departamento</b>"))
)
figdata_total_departamento_acumulado <- Datos_Dpto_completos |>
group_by(COD_DPTO_O, Departamento_ocurrencia) |>
summarise(Total_casos_acumulado = sum(Total_casos_dep_año), .groups = "drop") |>
arrange(desc(Total_casos_acumulado))
fig <- plot_ly(
data = data_total_departamento_acumulado,
x = ~Total_casos_acumulado,
y = ~reorder(Departamento_ocurrencia, Total_casos_acumulado),
type = 'bar',
orientation = 'h',
marker = list(color = 'navy')
) %>%
layout(
title = "Casos acumulados por departamento",
xaxis = list(title = "Total casos acumulados"),
yaxis = list(title = "", automargin = TRUE)
)
figDatos_Dpto_completos <- Datos_Dpto_completos %>%
mutate(Tasa = (Total_casos_dep_año / Poblacion_2023) * 100000)
colombia <- colombia %>%
mutate(DPTO = as.character(DPTO))
Datos_Dpto_completos <- Datos_Dpto_completos %>%
mutate(COD_DPTO_O = as.character(COD_DPTO_O))
Datos_Dpto_completos <- Datos_Dpto_completos %>%
mutate(
Departamento_ocurrencia = trimws(Departamento_ocurrencia),
Departamento_ocurrencia = case_when(
Departamento_ocurrencia == "NORTE SANTANDER" ~ "NORTE DE SANTANDER",
Departamento_ocurrencia == "ARAUCA" ~ "ARAUCA ",
Departamento_ocurrencia == "SAN ANDRES" ~ "SAN ANDRÉS",
TRUE ~ Departamento_ocurrencia
)
)
BASE_DPTO <- colombia %>%
left_join(Datos_Dpto_completos, by = c("NOMBRE_DPT" = "Departamento_ocurrencia" ))
summary(BASE_DPTO$Total_casos_dep_año) Min. 1st Qu. Median Mean 3rd Qu. Max.
8.0 203.0 620.5 900.0 1101.0 6286.0
colores_personalizados <- colorRampPalette(c("darkgreen", "yellow", "orange", "red", "blue", "navy"))(200)
ggplot(BASE_DPTO) +
geom_sf(aes(fill = Total_casos_dep_año),
color = "navy", lwd = 0.3) +
labs(
title = "Total de Casos de Intentos de Suicidio \n por Departamento",
x = NULL, y = NULL, fill = "Total de Casos."
) +
scale_fill_gradientn(
colours = colores_personalizados,
limits = range(BASE_DPTO$Total_casos_dep_año, na.rm = TRUE),
breaks = pretty(BASE_DPTO$Total_casos_dep_año, n = 5),
labels = as.character(pretty(BASE_DPTO$Total_casos_dep_año, n = 5))
) +
theme_minimal() +
theme(
plot.title = element_text(size = 12, hjust = 0.2),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
legend.position = "top",
legend.key.width = unit(1.5, "cm")
)colores_personalizados <- colorRampPalette(c("darkgreen", "yellow", "orange", "red", "blue", "navy"))(200)
ggplot(BASE_DPTO) +
geom_sf(aes(fill = Tasa),
color = "navy", lwd = 0.3) +
labs(
title = "Tasa de Intentos de Suicidio \n por Departamento",
x = NULL, y = NULL, fill = "Tasa por\n100 mil hab."
) +
scale_fill_gradientn(
colours = colores_personalizados,
limits = range(BASE_DPTO$Tasa, na.rm = TRUE),
breaks = pretty(BASE_DPTO$Tasa, n = 5),
labels = as.character(pretty(BASE_DPTO$Tasa, n = 5))
) +
theme_minimal() +
theme(
plot.title = element_text(size = 12, hjust = 0.2),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
legend.position = "top",
legend.key.width = unit(1.5, "cm")
)data=left_join(
colombia%>% mutate(DPTO=as.numeric(DPTO)),
Datos_Dpto_completos %>% mutate(COD_DPTO_O=as.numeric(COD_DPTO_O)),
by=c("DPTO"="COD_DPTO_O"))
VAUPES_geom=data[data$NOMBRE_DPT =="VAUPES",]
bbox=st_bbox(VAUPES_geom)
b <- ggplot(data) +
geom_sf(aes(fill = Tasa), color = "black", lwd = 0.3) +
annotate("rect",
xmin = bbox["xmin"], xmax = bbox["xmax"],
ymin = bbox["ymin"], ymax = bbox["ymax"],
color = "black", fill = NA, linewidth = 1) +
labs(title = "", x = NULL, y = NULL, fill = "Tasa") +
scale_fill_gradientn(
colors = colores_personalizados,
trans = "pseudo_log",
breaks = c(0, 50, 100, 150, 200, 250),
labels = c("0", "50", "100", "150", "200", "250")
) +
theme_minimal() +
theme(
plot.title = element_text(size = 16, hjust = 0.5),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
legend.position = "left",
legend.key.width = unit(0.5, "cm"),
legend.key.height = unit(1, "cm")
)
colombia_esp <- read_sf("Colombia municipios.geojson")
VAUPES <- Datos_completos |>
filter(Departamento_ocurrencia == "VAUPES")
data_VAUPES <- VAUPES |>
mutate(Total_casos = as.numeric(Total_casos)) |>
group_by(Municipio_ocurrencia,COD_MUN_O ) |>
summarise(Total_Confirmados = sum(Total_casos))
colombia_esp <- colombia_esp %>%
mutate(DPTO_CNMBR = if_else(DPTO_CNMBR == "VAUPÉS", "VAUPES", DPTO_CNMBR))
VAUPES_geom_esp <- colombia_esp |> filter(DPTO_CNMBR == "VAUPES")
data_VAUPES_esp <- left_join(
VAUPES_geom_esp |> mutate(MPIO_CCDGO = as.numeric(MPIO_CCDGO)),
data_VAUPES |> mutate("COD_MUN_O" = as.numeric(COD_MUN_O)),
by = c("MPIO_CCDGO" = "COD_MUN_O")
)
data_VAUPES_esp$Total_Confirmados[is.na(data_VAUPES_esp$Total_Confirmados)] <- 0
a=ggplot(data_VAUPES_esp)+
geom_sf(aes(fill=Total_Confirmados), color="black", lwd=0.3)+
labs( title = "",x=NULL, y=NULL, fill="Total")+
scale_fill_gradientn(
colors=colores_personalizados,
trans="pseudo_log",
breaks=c(0.00, 13.00 , 26.00 , 44.25,81.00 , 375.00 ),
labels=c("0.00", "13.00" , "26.00" , "44.25", "81.00" ,"375.00" ))+
theme_minimal()+
theme(plot.title = element_text(size=16,hjust=0.5),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
legend.position = "left",
legend.key.width = unit(0.5,"cm"),
legend.key.height = unit(1,"cm"))
mapas_combinados <- ggarrange(b,a,
ncol=2,nrow = 1,
common.legend = FALSE)
annotate_figure(mapas_combinados,top = text_grob("Tasa de Intentos de Suicidio \n en VAUPÉS", face = "bold",size = 14))